perm filename XM3.FAI[TMP,LCS] blob
sn#490172 filedate 1980-01-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE XM
C00004 00003 BEG: SETOM LINE
C00009 00004 XINI: SKIPN GO
C00012 00005 MOVE A,E ROTATION
C00016 00006 XCHA: SETZ 14, ↓↓MOVE UP AND RIGHT
C00019 00007 MVLFT: MOVMS 0 MOVE LEFT THEN RIGHT
C00022 00008 OOBAR: SETZM OOBFLG GET HERE IF ALL READY OOB
C00026 00009 FINDL: HRRZ A,JOBREL CK IF BIG ENUF
C00032 00010 INBITS: PUSHJ P,NAMGET INPUT OLD BIT FILE
C00034 00011 CORUP
C00036 00012 ******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********
C00038 00013 GETNAM: MOVEI A, FILE SCAN
C00040 00014 FILNAM: 0 GLOPS OF JUNK
C00041 ENDMK
C⊗;
TITLE XM
EXTERNAL CLIP
;↓↓AC DEF
A←1
B←2
C←3
D←4
E←5
L←6
U←7
X←11
Y←12
XD←13
T←15
TT←16
P←17
LPDL←←69
NBUFS←←4
DSK←←1
XGP←←2
LMAR←←=0
RMAR←←=1699
WIDTH←←=1700
LBUFL←←=48 ;LINE LENGTH IN WORDS
LSTBIT←←1⊗34
OVERLAP←←=50
DOFF←←-=760
EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
MAILBF: BLOCK 40
SIGN: 0
LINE: 0
PNTR: 0
BEG: SETOM LINE
GETLIN LINE ;FOR ERROR PRINTOUT
CALLI
HRRZS LINE ;CLEAR LINE BITS
HRRZI A,CORUP
HRRZM A,JOBAPR
;; SETZM XTRUNC ; X COORD. TRUNCATION FLAG(TYPE "-" TO INVOKE)
SETOM SSS#
HRRZ A,JOBFF ;RESET CORE WITHOUT A RESET
CORE A,
JRST 4,.
MOVEI A,20000 ;REG MPV
APRENB A, ;REG ENABLE OLD WAY!
MOVE P,[-LPDL,,PDL-1]
;Z OUTSTR [ASCIZ /OLD? /]
SETZM BIGBOT#
SETZM GO#
;NEXT LINE REPLACES FOLLOWING ;Z SECTION.
JRST FILIN ;******* NO 'OLD' FEATURE IN THIS VERSION. ******
;Z INCHWL E
;Z CAIE E,"B" ; B FOR BIG BOTTOM MARGIN (200=1")
;Z CAIN E,"b"
;Z CAIA
;Z JRST .+3
;Z SETOM BIGBOT
;Z JRST GOGO-1
;Z CAIE E,"L" ; L FOR LEGAL SIZE
;Z CAIN E,"l"
;Z JRST LEGLEG
;Z CAIE E,"G" ;IF 'G' SKIP ALL PROMPTS
;Z CAIN E,"g"
;Z CAIA
;Z JRST PASS
;Z PUSHJ P,FRD ;GO GET DEFAULT FILE NAME.
GONEW: PUSHJ P,FRD ;GO GET DEFAULT FILE NAME.
GOGO: MOVEI =11 ;DEFAULT PAGE LENGTH = 11" WITH 'G'
JRST GOGOGO
LEGLEG: PUSHJ P,FRD
LEGAL: MOVEI =14 ;TYPE 'L' FOR LEGAL SIZE 14"
GOGOGO: MOVEM GO
;;; SETOM GO ;FOR SKIPING ALL PROMPTS
; INCHWL E
; INCHWL E GET THE CRLF
CLRBFI ;INSTEAD OF ↑↑
OUTSTR [ASCIZ/USING DEFAULT VALUES.
/]
SETZM ROFLG#
HRREI B,-60 ;??
JRST PASS2
;ZPASS: CAIE E,"Y"
;Z CAIN E,"y"
;Z JRST INBITS
;Z CLRBFI
SETZM SPREAD#
FILIN: OUTSTR [ASCIZ /FILE? (DEFAULT=PLT.PLT) /]
PUSHJ P,FRD
SKIPE GO
JRST GONEW ;IF 'G' IS NAME THEN USE DEFAULT VALUES.
SETZ A,
YAGN1: HRREI B,-60
SETZM ROFLG
OUTSTR [ASCIZ/ROTATE? /] ;YOU CAN TYPE 'G' FOR GO HERE TOO.
INCHWL E
CAIE E,"Y"
CAIN E,"y"
SETOM ROFLG
CAIE E,"G"
CAIN E,"g"
JRST GOGO
CAIE E,"L"
CAIN E,"l"
JRST LEGAL
CLRBFI
OUTSTR [ASCIZ/ORIGIN X RIGHT OFFSET RIGHT (DEFAULT=4(CENTER))? /]
PUSHJ P,RNUM
JRST [ PASS2: HRREI A,-=760
JRST YDEF] ;GET Y INFO
IMULI A,=100
CAIN C,"." ;DECIMAL POINT?
JRST [ INCHWL C
CAIN C,15
INCHWL C
CAIL C,"0"
CAILE C,"9"
JRST .+1
SUBI C,60
IMULI C,=10
SKIPE SIGN
MOVN C,C
ADD A,C
PUSH P,A
PUSHJ P,RNUM
JFCL
POP P,A
JRST .+1] ;.+1??
MOVN A,A
LSH A,1 ;*2 (MAKE IT STEPS)
YDEFP: CAIE C,12
JRST [ CLRBFI
JRST YAGN1]
YDEF: ADD A,B
MOVNM A,INIX#
AGAIN: MOVE A,[FILNAM,,LKENT]
BLT A,LKENT+3
OPEN DSK,[14↔'DSK '↔IBUF]
JRST 4,.
INBUF DSK,NBUFS
LOOKUP DSK,LKENT
JRST FNF
ASKLEN: SETZM POOBX#
SETZM POOBY#
PUSHJ P,XINI ;GET X INFO
; JRST CORLUZ
SETZM XX#
SETZM YY#
MOVEI C,3
HRRZM C,PENN#
OUTER: IN DSK,
JRST PLOT
STATO DSK,20000
JRST 4,.
RELEAS DSK,
IFN LSTBIT-1,<PUSHJ P,XFIX>
JRST PCUT
XINI: SKIPN GO
OUTSTR [ASCIZ /LENGTH IN INCHES (Y DIMENSION, DEFAULT=11)? /]
SETZM DEFA#
SKIPE GO
JRST PASSD
PUSHJ P,RNUM
SETOM DEFA ;ASSUME 11 INCHES
JUMPLE A,[XINLER:CLRBFI
JRST XINI]
SKIPGE DEFA ;? GO?
PASSD: HRRZI A,=11
SKIPE GO
MOVE A,GO
;;PASSD: MOVE A,GO ;EITHER 11 OR 14
CAIE C,12
JRST XINLER
IMULI A,=200
PUSH P,A
YINI1: SKIPE GO
JRST PASS3
SKIPL ROFLG
OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=75)? \]
SKIPGE ROFLG
OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=1000)? \]
PUSHJ P,RNUM
PASS3: JRST [ MOVEI A,=75
SKIPE BIGBOT ;BIGBOT=NEG=200 BOTTOM MARGIN
MOVEI A,=200
SKIPGE ROFLG
MOVEI A,=1000
JRST IYDEF]
CAIE C,12
JRST [ CLRBFI
JRST YINI1]
IYDEF: MOVEM A,SHIFT# ;A MINUS NUMBER SHIFTS IMAGE DOWN OFF PAGE
;IYDEF: IMULI A,LBUFL+1
; MOVEM A,IYPOS#
POP P,A
XDEF: MOVEM A,LINCNT#
MOVEI B,-1(A)
IMULI A,LBUFL+1 ;A← BUFSIZ ← ROWS * COL
MOVE T,JOBFF ;GET START ADDR
MOVEM T,XGPPTR
SOS XGPPTR
MOVEI T,2(A)
MOVNI TT,(T)
ADD T,XGPPTR
HRLM TT,XGPPTR ;XGPPTR← -WDCNT,,ADDR-1
MOVE TT,T
HRRZ L,XGPPTR
MOVSI T,1(L)
HRRI T,2(L)
SETZM 1(L)
MOVE U,JOBREL
BLT T,(U) ;ZERO TO END OF CORE
HRRZI U,(TT)
MOVEM B,SVBBB#
;; MOVE Y,IYPOS
;; ADDI Y,2(L)
MOVEI Y,2(L)
MOVEI XD,DBUF+1
SKIPL A,INIX ;WHERE DO WE START
JRST MAYBON
SUBI A,43
IDIV A,[-44]
HRLOI X,XD
SOJA A,SETB
MAYBON: ADDI A,43
IDIVI A,44
CAILE A,LBUFL
JRST OFFRT
MOVE X,A
SETZ A,
HRLI X,Y
JRST SETB
OFFRT: MOVE X,[XD,,LBUFL]
SUBI A,LBUFL
SETB: MOVE B,INIX
IDIVI B,44
MOVSI B,400000
MOVN C,C
ROT B,(C)
POPJ P,
POPJ1: AOS (P)
CPOPJ: POPJ P,
RTSIDE: =840
LFSIDE: -=840
TOP: 0
BOT: 0
MOVE A,E ;ROTATION
ROTA: MOVE 14,2(A)
LSHC 14,-10
HLLZ C,15
LSHC 14,-16
HLLZ D,15
LSHC 14,-16
EXCH 15,D
LSHC 14,16
ASH D,-26
MOVN 15,D
LSH 15,26
LSHC 14,16
HLLZ 15,C
LSHC 14,10
MOVEM 14,2(A)
AOBJN A,ROTA
JRST PLOT1
PLOT: HRR C,IBUF+1
MOVN E,1(C) ;FIX FOR NO WDCNT
MOVSI E,(E)
HRR E,IBUF+1
SKIPGE ROFLG
JRST ROTA-1
PLOT1: MOVE 14,2(E)
LSHC 14,-10
ASH 15,-34
MOVEM 15,SVPEN# ;GET PEN CODE
MOVM A,15
LSHC 14,-16
ASH 15,-26
SKIPL SVPEN
SSSS: ADD 15,SHIFT# ;SHIFTS ONLY AFTER (0,0) IS SET (SVPEN=-3)
MOVEM 15,SVY# ;GET Y
LSHC 14,-16
ASH 15,-26
MOVEM 15,SVX# ;GET X
MOVEM 1,AC1#
MOVEM 2,AC2#
MOVEM 3,AC3#
MOVEM 4,AC4#
MOVEM 5,AC5#
MOVEM 6,AC6#
MOVEM 7,AC7#
JSA 16,CLIP
JUMP SVX
JUMP SVY
JUMP SVPEN
JUMP RTSIDE
JUMP LFSIDE
JUMP TOP
JUMP BOT
MOVE 1,AC1
MOVE 2,AC2
MOVE 3,AC3
MOVE 4,AC4
MOVE 5,AC5
MOVE 6,AC6
MOVE 7,AC7
CLPDON: MOVE 15,SVY
SUB 15,YY
MOVEM 15,SVYSB# ;SAVE Y DIFF
IMULI 15,LBUFL+1
ADD 15,Y
MOVEM 15,SVYOD# ;SAVE NEW Y
MOVE 15,SVX
SUB 15,XX
MOVE 0,15 ;0 HAS X DIFF
HRRZ 16,X
IMULI 16,44 ;TIMES BITS INA WORD
JFFO B,.+1
ADD 16,C ;PLUS REMAINDER EQ OLD X
SUB 16,15
JUMPL 16,LOSEX
CAILE 16,=1727
JRST LOSEX
SKIPE OOBFLG# ;CK IF ALREADY OOB
JRST OOBAR
FIXUP: CAIE A,1 ;FIXUP WHAT?
HRRM A,PENN
HRR A,PENN ;SAME PEN IF 1
CAIN A,3
JRST PENUP ;PENUP IF 3
MOVE C,SVYSB ;Y DIFF
IORM B,@X ;MARK NOW X Y
;FIND DIRECTION
JUMPE NORMX ;VERT OR NO MOVE
JUMPL MVLFT ;LEFT
JUMPE C,NRT ;HORZ
JUMPL C,MVDWN ;DOWN
CAMLE C,0 ;JUMP IF Y DIFF > X DIFF
JRST XCHA
SETZ 14, ;↓↓ MOVE UP AND RIGHT
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG INLOOP
JRST DONXT
XCHA: SETZ 14, ;↓↓MOVE UP AND RIGHT
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
INLOO: ADD 15,0
TLZN 15,200000
JRST MVUP
SKIPGE B
SOJ X,
ROT B,1
MVUP: ADDI Y,LBUFL+1
IORM B,@X
SOJG C,INLOO
JRST DONXT
MVDWN: MOVMS C ;↓↓MOVE DOWN AND RIGHT
CAMLE C,0
JRST XCHA2 ;JUMP IF YDIFF > XDIFF
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG INLOP
JRST DONXT
XCHA2: SETZ 14, ;↓↓MOVE DOWN AND RIGHT
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
INOOP: ADD 15,0
TLZN 15,200000
JRST MVEX
SKIPGE B
SOJ X,
ROT B,1
MVEX: SUBI Y,LBUFL+1
IORM B,@X
SOJG C,INOOP
JRST DONXT
NRT: JUMPL B,GOOP ;HORZ RIGHT
TOOT: ROT B,1
IORM B,@X
SOJG 0,NRT
JRST DONXT
GOOP: SOJ X,
CAIGE 0,44
JRST TOOT
IDIVI 0,44
SETOM @X
SOJ X,
SOJG 0,.-2
HRR 0,1
JUMPN 0,TOOT
AOJ X,
JRST DONXT
NLFT: MOVMS 0 ;HORZ LEFT
ROT B,-1
JUMPL B,ROOT
WOOP: IORM B,@X
SOJG 0,.-3
JRST DONXT
ROOT: AOJ X,
CAIGE 0,44
JRST WOOP
IDIVI 0,44
SETOM @X
AOJ X,
SOJG 0,.-2
HRR 0,1
JUMPN 0,WOOP
SOJ X,
ROT B,1
JRST DONXT
NORMX: JUMPE C,NOMOVE ;NO DIFF
JUMPL C,MDOWN ;MOVE VERT DOWN
MUP: ADDI Y,LBUFL+1 ;MOVE VERT UP
IORM B,@X
SOJG C,MUP
JRST DONXT
MDOWN: SUBI Y,LBUFL+1 ;MOVE VERT DOWN
IORM B,@X
AOJL C,MDOWN
DONXT: MOVE 4,SVX ;DONE. NOW UPDATE X AND Y
MOVEM 4,XX
NXTY: MOVE 4,SVY
MOVEM 4,YY
NOMOVE: SKIPL SVPEN
JRST ENOUT
SETZM XX ;IF NEW LOCO
SETZM YY
ENOUT: AOBJN E,PLOT1 ;GET NEXT
JRST OUTER
MVLFT: MOVMS 0 ;MOVE LEFT THEN RIGHT
MOVMS 15
JUMPE C,NLFT
HRR Y,SVYOD
IDIVI 15,44
ADD X,15
XEND: SOJL 16,DUN
ROT B,-1
JUMPGE B,XEND
AOJ X,
JRST XEND
DUN: MOVEM X,XX ;SAVE NEW X POS
MOVEM B,YY
IORM B,@X
JUMPL C,MVLD
CAMLE C,0
JRST XCHA3
SETZ 14, ;MOVE LEFT UP
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
ILOOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG ILOOP
JRST BFOR
XCHA3: SETZ 14,
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
ILOP: ADD 15,0
TLZN 15,200000
JRST DOQ
SKIPGE B
SOJ X,
ROT B,1
DOQ: SUBI Y,LBUFL+1
IORM B,@X
SOJG C,ILOP
JRST BFOR
MVLD: MOVMS C ;MOVE LEFT DOWN
CAMLE C,0
JRST XCHA4
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
LOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG LOOP
JRST BFOR
XCHA4: SETZ 14,
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
LOP: ADD 15,0
TLZN 15,200000
JRST DOP
SKIPGE B
SOJ X,
ROT B,1
DOP: ADDI Y,LBUFL+1
IORM B,@X
SOJG C,LOP
BFOR: HRR Y,SVYOD ;RESTORE PEN TO NEW PEN
MOVE X,XX
MOVE B,YY
JRST DONXT
OOBAR: SETZM OOBFLG ; GET HERE IF ALL READY OOB
AOSG SSS ; THIS IS FOR THE FIRST OOB FROM MP
JRST FIXUP ;
PENUP: HRR Y,SVYOD ; PEN IS UP GET NEW Y
JUMPE 15,NXTY ;IF VERT
JUMPL 15,PULFT ;IF LEFT
CAIGE 15,44 ;↓↓MOVE UP PEN RIGHT TO NEW X
JRST XLOOP
IDIVI 15,44
SUB X,15
HRR 15,16
XLOOP: SOJL 15,DONXT
SKIPGE B
SOJ X,
ROT B,1
JRST XLOOP
PULFT: MOVMS 15 ;↓↓MOVE UP PEN LEFT TO NEW X
CAIGE 15,44
JRST OOO
IDIVI 15,44
ADD X,15
HRR 15,16
OOO: SOJL 15,DONXT
ROT B,-1
JUMPGE B,OOO
AOJ X,
JRST OOO
LOSEX: SETOM OOBFLG ;OOB X
SKIPE POOBX
JRST PENUP
SETOM POOBX
PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /POINT OUT OF BOUNDS, /
JUMPL 16,[PUSHJ P,ERRPNT
ASCIZ/-X/
JRST PENUP]
PUSHJ P,ERRPNT
ASCIZ/+X/
JRST PENUP
LOSE: SETOM OOBFLG ;OOB Y
SKIPE POOBY
JRST LOBAC
SETOM POOBY
PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /POINT OUT OF BOUNDS, /
CAIGE 15,(L)
JRST [ PUSHJ P,ERRPNT
ASCIZ/-Y/
JRST LOBAC]
PUSHJ P,ERRPNT
ASCIZ/+Y/
LOBAC: LSHC 14,-16
ASH 15,-26
;;; CAMN 15,SVX
;;; JRST TRUNCY ;GO TRUNCATE IF X IS SAME AS BEFORE (VERTICAL)
;;; MOVE 14,SVPEN
MOVEM 15,SVX
;;; CAIN 14,3 ;PEN UP?
;;; JRST TRUNCY
SUB 15,XX
JRST PENUP
;TRUNCY: MOVE 15,SVYOD
; CAIGE 15,(L)
; JRST [ MOVEI 15,-LBUFL-1(U)
; JRST TRUNCZ]
; MOVEI 15,(L)
; SOJ 15,
;TRUNCZ: MOVEM 15,SVYOD
; SUB 15,Y
; IDIVI 15,LBUFL+1
; MOVEM 15,SVYSB
; ADD 15,YY
; MOVEM 15,SVY ;NOW ALL IS SHIFTED
; MOVE 15,SVX ;GET OLD X
; JRST YTRUNC
DECOUT: IDIVI T,=10 ;DEC TTY OUT
HRLM TT,(P)
SKIPE T
PUSHJ P,DECOUT
HLRZ TT,(P)
ADDI TT,60
ROT TT,-7
MOVEM TT,.+2
PUSHJ P,ERRPNT
0
POPJ P,
ERRPNT: HRRZ TT,(P) ;ERROR TTY OUT
MOVEM TT,PNTR
MOVEI TT,LINE
TTYMES TT,
JRST [ OUTSTR[ASCIZ/TTYMES FAILED /]
OUTSTR @PNTR
OUTSTR[ASCIZ/
/]
JRST .+1]
POP P,TT
HRL TT,(TT)
TLNE TT,376
AOJA TT,.-2
JRST 1(TT)
XERR: PUSHJ P,ERRPNT ;DET TTY OUT
ASCIZ/
MESSAGE FROM X WORKING ON /
MOVE TT,FILNAM
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/./
HLLZ TT,FILEXT
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/[/
MOVE TT,FILPPN
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/] : /
POPJ P,
SIXOUT: JUMPE TT,CPOPJ ;SIXBIT OUT
SETZ T,
LSHC T,6
ADDI T,40
PUSH P,TT
ROT T,-7
MOVEM T,.+2
PUSHJ P,ERRPNT
0
POP P,TT
JRST SIXOUT
DETCHK: SETOM DET# ;CK FOR DET JOB
GETLIN DET
HRRES DET
SKIPL DET
AOS (P)
POPJ P,
FINDL: HRRZ A,JOBREL ;CK IF BIG ENUF
CAIL A,-LBUFL-1(U)
JRST XINL-1
XL2: MOVEM TT,(T) ;ADD MORE AND MARK
ADDI T,LBUFL+1
CAIGE T,(A)
JRST XL2
SUBI A,(L)
MOVNS A
HRLM A,XGPPTR
SUBI T,LBUFL+1
JRST XXOUT
PCUT: HRRZ L,XGPPTR ;MARK BLOCK FOR XGP
MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
MOVEM TT,1(L) ;FIRST ONE HAS MARK AND CUT WITH IT
TLZ TT,400000 ;DELETE MARK AND CUT
MOVEI T,1+LBUFL+1(L)
SKIPGE DEFA
JRST FINDL
MOVE B,SVBBB
XINL: MOVEM TT,(T)
ADDI T,LBUFL+1
SOJG B,XINL
HLRO TT,XGPPTR
MOVNS TT
ADDI TT,(L)
MOVE A,(TT)
XXOUT: MOVSI TT,400100
MOVEM TT,(T) ;SO DOES LAST
SKIPN SPREAD
JRST XGPOUT
HRRZ T,XGPPTR
ADDI T,LBUFL+1
HRRZ C,SVBBB
SKIPG SPREAD
JRST NINE
XLINE4: HRLI T,-LBUFL
XSHFT4: MOVE A,2(T)
MOVE B,3(T)
ROTC A,1
ORM A,2(T)
AOBJN T,XSHFT4
AOJ T,
SOJG C,XLINE4
HRRZ T,XGPPTR
HRRZ B,SVBBB
YLINE4: HRLI T,-LBUFL
YSHFT4: MOVE A,LBUFL+3(T)
ORM A,2(T)
AOBJN T,YSHFT4
AOJ T, ;Bump past control word.
SOJG B,YLINE4
JRST XGPOUT
NINE: HRLI T,-LBUFL
XSHFT9: MOVE A,2(T)
MOVE B,3(T)
ROTC A,1
ORM A,2(T)
ROTC A,1
ORM A,2(T)
AOBJN T,XSHFT9
AOJ T,
SOJG C,NINE
HRRZ T,XGPPTR
HRRZ B,SVBBB
YLINE9: HRLI T,-LBUFL
YSHFT9: MOVE A,LBUFL+LBUFL+4(T)
OR A,LBUFL+3(T)
ORM A,2(T)
AOBJN T,YSHFT9
AOJ T,
SOJG B,YLINE9
XGPOUT: OPEN XGP,XNIT ;XGP OUTPUT
;;; PUSHJ P,NOXGP
JRST NOXGP
OUTSTR[ASCIZ/CRANKING XGP
/]
LOCK
OUTIT: OUT XGP,XGPPTR
JRST OUTOK
DSKERR: PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /XGP OUTPUT ERROR.
/
OUTOK: UNLOCK
RELEAS XGP,
XMORE: PUSHJ P,DETCHK
;; JRST DODEL ;DELETE AUTOMATICALLY IF DETACHED
JFCL
OUTSTR[ASCIZ/D=DELETE, R=REPEAT, X=EXIT /]
INCHRW C
CAIE C,15
JRST .+3
INCHRW C
JRST XMORE+2 ; WON'T ACCEPT JUST CRLF
OUTSTR[ASCIZ/
/]
CAIE C,"X"
CAIN C,"x"
SKIPA
JRST .+3
PUSHJ P,CORDWN ;REALLY DONE, CORE DOWN
JRST NODEL
CAIE C,"R"
CAIN C,"r"
JRST XGPOUT
CAIE C,"D"
CAIN C,"d"
SKIPA ;IF NOT R, X OR D TRY AGAIN.
JRST XMORE+2
PUSHJ P,CORDWN ;REALLY DONE, CORE DOWN
DODEL: MOVE A,[FILNAM,,LKENT]
BLT A,LKENT+3
INIT DSK,17
'DSK '
0
JRST [ SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/COULDN'T GET DISK FOR DELETE!
/
JRST NODEL]
LOOKUP DSK,LKENT
JRST [ SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/LOOKUP FOR DELETE FAILED!
/
JRST NODEL]
MOVE A,FILPPN
MOVEM A,LKENT+3
SETZM LKENT
RENAME DSK,LKENT
CAIA
JRST NODEL
SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/RENAME FOR DELETE FAILED!
/
NODEL: RELEASE DSK,
SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/ALL DONE!
/
CALLI 12 ;LEAVE
NOXGP: PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /
WAITING FOR XGP /
;ZZ ASCIZ /
;ZZXGP BUSY, OUTPUT TO DISK? /
;ZZ INCHRW A
;ZZ CAIE A,"Y"
;ZZ CAIN A,"y"
;ZZ JRST OUTFIL
HRRZI A,1017
HRRZM A,XNIT
;;; POPJ P,
JRST XGPOUT
XNIT: 417
'XGP '
0
XGPPTR: BLOCK 2
IFN LSTBIT-1,<
XFIX: MOVE A,[LSTBIT-1]
HRRZ C,JOBREL
HRRZ D,XGPPTR
XFIXL: ANDCAM A,LBUFL-1+2(D)
ADDI D,LBUFL+1
CAIGE D,(C)
JRST XFIXL
POPJ P,
>
CORDWN: MOVE T,JOBFF
SUBI T,1
CALLI T,11
JRST 4,.
POPJ P,
INBITS: PUSHJ P,NAMGET ;INPUT OLD BIT FILE
HRRZ U,JOBFF
HRRZI T,177(U)
CORE T,
JRST INBITS
SOJ U,
HRLI U,-200
OPEN [17↔'DSK '↔0]
JRST INBITS
LOOKUP FILNAM
JRST INBITS
SETZ 10,
TRYTRY: OPEN XGP,XNIT ;***** GRAB THE XGP BEFORE CORE EXPANSION
JRST NONO ;CAN'T GET IT!
INPUT U
MOVE T,[BYTE (12)4001,LMAR,LBUFL]
EXCH T,1(U)
HLL U,T
MOVEM U,XGPPTR
HRLI U,(T)
TLNN U,777777
JRST CLOZE
ADDI U,200
MOVNI T,(T)
ADDI T,(U)
CORE T,
JRST INBITS ;HANG
INPUT U
CLOZE: RELEAS
JRST XGPOUT
NONO: OUTSTR[ASCIZ/
WAITING FOR XGP /]
HRRZI A,1017
HRRZM A,XNIT
JRST TRYTRY
OUTFIL: PUSHJ P,NAMGET ;OUTPUT BIT FILE
MOVE U,XGPPTR
HLRO T,U
MOVNS T
TRZ T,177
HRRZI A,200(T)
ADDI A,(U)
CORE A,
JRST OUTFIL
MOVNS T
HLL T,U ;FIRST WD IS WC-200,-WC
MOVEM T,1(U)
HRLI U,-200(T)
SETZ 10,
OPEN [17↔'DSK '↔0]
JRST 4,.
ENTER FILNAM
CAIA
OUTPUT U
RELEAS
JRST NODEL
;CORUP
CORUP:
REPEAT 0,< OLD WAY - FLUSHED BY REG 1-3-76
HRRZ B,JOBCNI
CAIE B,20000
DISMIS
MOVE A,JOBTPC
MOVEM A,IPC+1
UWAIT
DEBREAK
>;END REPEAT 0
BUST: MOVEM 1,SVONE#
MOVEM 2,SVTWO#
MOVEM TT,SVTTT#
MOVE 1,JOBCNI ;REG GET APR CONI BITS
TRNN 1,20000 ;REG IS THERE AN MPV?
JRST NOMPV ;REG NO
HRRZ 1,JOBREL ;OLD CORE SIZE
MOVSI 2,1(1) ;FIRST NEW WORD WE'LL GET
HRRI 2,2(1) ;SECOND NEW WORD - 2 HAS A BLT POINTER.
ADDI 1,16000
;; ADDI 1,10000 ;GET ANOTHER 8K
MOVE TT,1
CORE 1,
PUSHJ P,CORLUZ
HRRZ 1,JOBREL
SETZM -1(2)
BLT 2,(1) ;ZERO NEW CORE
MOVE 1,SVONE
MOVE 2,SVTWO
MOVE TT,SVTTT
REPEAT 0,<
INTJEN IPC
>
JRST 2,@JOBTPC ;REG THIS IS HOW TO DISMISS OLD INTERRUPT
NOMPV: OUTSTR [ASCIZ/UNEXPECTED INTERRUPT?
/]
JRST 2,@JOBTPC
CORLUZ: MOVE T,TT
LSH T,-12
PUSH P,T
PUSHJ P,DETCHK
PUSHJ P,XERR
POP P,T
PUSHJ P,DECOUT
PUSHJ P,ERRPNT
ASCIZ / K OF CORE NEEDED!
/
SKIPGE DET
CALLI 12
JRST ASKLEN
FNF: PUSHJ P,DETCHK ;FILE NOT FOUND
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /LOOKUP FAILED.
/
SKIPGE DET
CALLI 12
JRST FILIN
;******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********
FRD: MOVSI A,'PLT' ;FILE SCAN
MOVEM A,FILEXT
SKIPN GO
JRST .+3 ;GO?
MOVEI C,12 ; CR
JRST .+3
PUSHJ P,GETNAM
CAME A,[SIXBIT/G/] ;G ALONE = 'GO'
JRST GOX
SETOM GO ;GO BACK AND USE DEFAULT NAME.
POPJ P,
GOX: CAMN A,[SIXBIT/-/] ;LOOK FOR "-" (TRUNCATES X TO EDGE)
JRST [ SETOM XTRUNC#
JRST POPBAC]
CAME A,[SIXBIT/4/] ;FOR * FOUR DOTS
JRST CKSEMI
AOS SPREAD
POPBAC: POP P,A
CLRBFI
JRST FILIN
CKSEMI: CAME A,[SIXBIT/9/] ;FOR * NINE
JRST CKDEFA
SETOM SPREAD
JRST POPBAC
CKDEFA: SKIPN A
MOVE A,['PLT ']
MOVEM A,FILNAM
CAIE C,"."
JRST NOEXT
PUSHJ P,GETNAM
MOVEM A,FILEXT
NOEXT: CAIE C,"["
JRST FRDX
PUSHJ P,GETP
HRLZM A,FILPPN
PUSHJ P,GETP
HRRM A,FILPPN
FRDX: SKIPN GO
INCHRW C
CAIE C,12
JRST FRDX
POPJ P,
RNUM: INCHWL C ;NUM SCAN
CAIN C,15
JRST RNUM
CAIN C,12
POPJ P,
AOS (P)
MOVEI A,
SETZM SIGN
CAIN C,"-"
JRST [ PUSHJ P,RNUML
SETOM SIGN
MOVN A,A
POPJ P,]
CAIN C,"+"
RNUML: INCHWL C
CAIL C,"0"
CAILE C,"9"
JRST RNUMX
IMULI A,12
ADDI A,-"0"(C)
JRST RNUML
RNUMX: CAIN C,15
INCHRW C
POPJ P,
GETNAM: MOVEI A, ;FILE SCAN
MOVE B,[440600,,A]
GETNML: PUSHJ P,RCH
POPJ P,
SUBI C,40
TLNE B,770000
IDPB C,B
JRST GETNML
GETP: MOVEI A,
GETPL: PUSHJ P,RCH
POPJ P,
TRNE A,770000
JRST GETPL
LSH A,6
ADDI A,-40(C)
JRST GETPL
RCH: INCHWL C
CAIN C,42
JRST RCHQ
CAIE C,11
CAIN C," "
JRST RCH
CAIE C,"."
CAIN C,","
POPJ P,
CAIE C,"["
CAIN C,"]"
POPJ P,
RCHQR: CAIGE C,40
POPJ P,
CAIL C,"a"
CAILE C,"z"
CAIA
SUBI C,40
JRST POPJ1
RCHQ: INCHWL C
JRST RCHQR
NAMGET: CLRBFI
OUTSTR [ASCIZ/
FILE = /]
SETZM FILEXT+1
SETZM FILPPN
MOVSI A,'BIT'
MOVEM A,FILEXT
PUSHJ P,GETNAM
SKIPN A
MOVE A,['PLT ']
MOVEM A,FILNAM
CAIE C,"."
JRST NOEXTN
PUSHJ P,GETNAM
MOVEM A,FILEXT
NOEXTN: CAIE C,"["
JRST FFDX
PUSHJ P,GETP
HRLZM A,FILPPN
PUSHJ P,GETP
HRRM A,FILPPN
FFDX: INCHRW C
CAIE C,12
JRST FFDX
POPJ P,
FILNAM: 0 ;GLOPS OF JUNK
FILEXT: 0
0
FILPPN: 0
LKENT: BLOCK 4
XGSNAM: 0
XGSEXT: 0
0
XGSPPN: 0
IBUF: BLOCK 3
BITTAB: FOR I←43,0,-1{1⊗I
}
BYTTAB: FOR I←36,0,-6{REPEAT 6,{77⊗I}}
DBUF: BLOCK LBUFL+2
PDL: BLOCK LPDL
END BEG